;Person A:	Jim McAllister
;			cs61a-cs
;Person B:	Yunliang Li
;			cs61a-et
;	Section 20
;	proj3b

;; ADV.SCM
;; This file contains the definitions for the objects in the adventure
;; game and some utility procedures.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; basic-object                                               b4a
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-class (basic-object)
  (instance-vars
   (properties (make-table)))
  
  (default-method 
     (lookup message properties))
    
  (method (put key value)
     (insert! key value properties))

  (method (get key)
     (lookup key properties)))

  


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  

(define-class (place name)
  (parent (basic-object))  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;b4a
  (instance-vars
   (directions-and-neighbors '())
   (things '())
   (people '())
   (entry-procs '())
   (exit-procs '()))
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B4b place?
  (method (place?) #t)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (method (type) 'place)
  (method (neighbors) (map cdr directions-and-neighbors))
  (method (exits) (map car directions-and-neighbors))
  (method (look-in direction)
    (let ((pair (assoc direction directions-and-neighbors)))
      (if (not pair)
	  '()                     ;; nothing in that direction
	  (cdr pair))))           ;; return the place object
  (method (appear new-thing)
    (if (memq new-thing things)
	(error "Thing already in this place" (list name new-thing)))
    (set! things (cons new-thing things))
    'appeared)
  (method (may-enter? person)
  	#t)
  (method (enter new-person)
    (if (memq new-person people)
	(error "Person already in this place" (list name new-person)))
	(set! people (cons new-person people))
    (for-each (lambda (proc) (proc)) entry-procs)
    (for-each (lambda (person) (ask person 'notice new-person)) (cdr people))
    'appeared)
  (method (gone thing)
    (if (not (memq thing things))
	(error "Disappearing thing not here" (list name thing)))
    (set! things (delete thing things)) 
    'disappeared)
  (method (exit person)
    (for-each (lambda (proc) (proc)) exit-procs)
    (if (not (memq person people))
	(error "Disappearing person not here" (list name person)))
    (set! people (delete person people)) 
    'disappeared)

  (method (new-neighbor direction neighbor)
    (if (assoc direction directions-and-neighbors)
	(error "Direction already assigned a neighbor" (list name direction)))
    (set! directions-and-neighbors
	  (cons (cons direction neighbor) directions-and-neighbors))
    'connected)

  (method (add-entry-procedure proc)
    (set! entry-procs (cons proc entry-procs)))
  (method (add-exit-procedure proc)
    (set! exit-procs (cons proc exit-procs)))
  (method (remove-entry-procedure proc)
    (set! entry-procs (delete proc entry-procs)))
  (method (remove-exit-procedure proc)
    (set! exit-procs (delete proc exit-procs)))
  (method (clear-all-procs)
    (set! exit-procs '())
    (set! entry-procs '())
    'cleared) )

(define-class (person name place)
  (parent (basic-object))  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; b4a
  (instance-vars
   (possessions '())
   (saying ""))
  (initialize
   (ask self 'put 'strength 100)
   (ask self 'put 'money 100)
   (ask place 'enter self))
   (method (type) 'person)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Method PERSON? B4b
  (method (person?) #t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (method (get-money amount)
          (ask self 'put 'money (+ (ask self 'get 'money) amount)))
  (method (pay-money amount)
          (if (< (ask self 'get 'money) amount)
              #f
              (begin (ask self 'put 'money (- (ask self 'get 'money) amount))
                #t)))
  (method (buy item)
          (let ((purchase (ask place 'sell self item)))
            (if (not purchase)
                '()
                (ask self 'take purchase))))
;                (set! possessions (cons purchase possessions)))))
  (method (look-around)
    (map (lambda (obj) (ask obj 'name))
	 (filter (lambda (thing) (not (eq? thing self)))
		 (append (ask place 'things) (ask place 'people)))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B8 reorganize TAKE
#|
  (method (take thing)
    (cond ((not (thing? thing)) (error "Not a thing" thing))
	  ((not (memq thing (ask place 'things)))
	   (error "Thing taken not at this place"
		  (list (ask place 'name) thing)))
	  ((memq thing possessions) (error "You already have it!"))

          ((not (eq? (ask thing 'possessor) 'no-one))
		(cond ((ask thing 'may-take? self)
		       (begin
			 (announce-take name thing)
			 (set! possessions (cons thing possessions))
	       
	   ;; If somebody already has this object...
			 (for-each
			  (lambda (pers)
			    (if (and (not (eq? pers self)) ; ignore myself
				     (memq thing (ask pers 'possessions)))
				(begin
				  (ask pers 'lose thing)
				  (have-fit pers))))
			  (ask place 'people))
	       
			 (ask thing 'change-possessor self)
			 'taken))
		      (else
		       (begin
			 (newline)
			 (display "can't take ")
			 (display (ask thing 'name))))))
	  (else
	   (begin
	     (announce-take name thing)
	     (set! possessions (cons thing possessions))
	     (ask thing 'change-possessor self)
	     'taken))))
|#
  (method (take thing)
    (cond ((not (thing? thing)) (error "Not a thing" thing))
	  ((not (memq thing (ask place 'things)))
	   (error "Thing taken not at this place"
		  (list (ask place 'name) thing)))
	  ((memq thing possessions) (error "You already have it!"))
	  (else
	   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B8.
	   (cond ((eq? (ask thing 'possessor) 'no-one)
		  (announce-take name thing)
		  (set! possessions (cons thing possessions))
		  (ask thing 'change-possessor self)
		  'taken)
	       
	   ;; If somebody already has this object...
	   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B8.
		 (else
		  (cond ((ask thing 'may-take? self)
			 (announce-take name thing)
			 (set! possessions (cons thing possessions))
			 (for-each
			  (lambda (pers)
			    (if (and (not (eq? pers self)) ; ignore myself
				     (memq thing (ask pers 'possessions)))
				(begin
				  (ask pers 'lose thing)
				  (have-fit pers))))
			  (ask place 'people))
			 (ask thing 'change-possessor self)
			 'taken)
			(else (display name) (display " is too weak to take the ")
			      (display (ask thing 'name)) (newline) (newline))))))))


  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; take-all
  (method (take-gen thing)
    (cond ((not (thing? thing)) (error "Not a thing" thing))
	  ((not (memq thing (ask place 'things)))
	   (error "Thing taken not at this place"
		  (list (ask place 'name) thing)))
	  (else
	   (cond ((eq? (ask thing 'possessor) 'no-one)
		  (begin
		   (announce-take name thing)
		   (set! possessions (cons thing possessions))
	           (ask thing 'change-possessor self)
	           'taken))
		 (else (begin
			 (newline)
			 (display "can't take ")
			 (display (ask thing 'name))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (method (take-all)
	  (for-each
	   (lambda (thi)
	     (ask self 'take-gen thi))
	   (ask (ask self 'place) 'things)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (method (lose thing)
    (set! possessions (delete thing possessions))
    (ask thing 'change-possessor 'no-one)
    'lost)
  (method (talk) (print saying))
  (method (set-talk string) (set! saying string))
  (method (exits) (ask place 'exits))
  (method (notice person) (ask self 'talk))
  (method (park-tkt)    ;retrieves park ticket from possessions, used for unpark method of garage class
          (car (filter (lambda (x) (eq? 'ticket (ask x 'name))) (ask self 'possessions))))
  (method (eat)
          (let ((snacks (filter edible? (ask self 'possessions))))
            (map (lambda (snack) 
                   (begin (ask self 'put 'strength (+ (ask self 'get 'strength)
                                                      (ask snack 'get 'calories)))
                     (ask self 'lose snack)
                     (ask place 'gone snack)
                     (print "yum, yum...")))
                 snacks)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B6a method GO-DIRECTLY-TO JAIL
  (method (go-directly-to new-place)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Enable this codes can limit method for jail only.
;;	  (cond ((not (equal? (ask new-place 'name) 'jail))
;;	       (error "Can't go" direction))
;;	      (else
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	  (cond ((null? new-place)
		 (error "Can't go to " new-place))
		
		(else
		 (ask place 'exit self)
		 (announce-move name place new-place)
		 (for-each
		  (lambda (p)
		    (ask place 'gone p)
		    (ask new-place 'appear p))
		  possessions)
		 (set! place new-place)
		 (ask new-place 'enter self))))	
	 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
  (method (go direction)
    (let ((new-place (ask place 'look-in direction)))
      (cond ((null? new-place)
	     (error "Can't go " direction))
	     	((not (ask new-place 'may-enter? self)) 
	     		(if (and (eq? (ask new-place 'type) 'locked-place)
	     					(ask new-place 'locked?))
	     			(display "The entry is locked")
	     			(display "You're not allowed there")))
	    (else
	     (ask place 'exit self)
	     (announce-move name place new-place)
	     (for-each
	      (lambda (p)
		(ask place 'gone p)
		(ask new-place 'appear p))
	      possessions)
	     (set! place new-place)
	     (ask new-place 'enter self))))) )

;(define thing
; (let ()
;    (lambda (class-message)
;      (cond
;       ((eq? class-message 'instantiate)
;	(lambda (name)
;	  (let ((self '()) (possessor 'no-one))
;	    (define (dispatch message)
;	      (cond
;	       ((eq? message 'initialize)
;		(lambda (value-for-self)
;		  (set! self value-for-self)))
;	       ((eq? message 'send-usual-to-parent)
;		(error "Can't use USUAL without a parent." 'thing))
;	       ((eq? message 'name) (lambda () name))
;	       ((eq? message 'possessor) (lambda () possessor))
;	       ((eq? message 'type) (lambda () 'thing))
;	       ((eq? message 'change-possessor)
;		(lambda (new-possessor)
;		  (set! possessor new-possessor)))
;	       (else (no-method 'thing))))
;	    dispatch)))
;      (else (error "Bad message to class" class-message))))))
(define-class (thing name)
	(parent (basic-object))
	(instance-vars
		(possessor 'no-one))
	(method (send-usual-to-parent)
		(error "Can't use USUAL without a parent." 'thing))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B8. Add method MAKE-TAKE?
	(method (may-take? receiver)
		(if (> (ask receiver 'strength)
		       (ask (ask self 'possessor) 'strength))
		    self
		    #f))

	(method (type) 'thing)
	(method (change-possessor new-possessor)
		(set! possessor new-possessor))


  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B4b. "thing?" method added
  (method (thing?) #t)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  )

;;; A6
;; 
(define-class (food name)
  (parent (thing name))
  (initialize (ask self 'put 'edible? #t)
              (ask self 'put 'calories 0)))

(define-class (bagel)
  (parent (food 'bagel))
  (class-vars (name 'bagel))
  (initialize (ask self 'put 'calories 100)))
(define-class (coffee)
  (parent (food 'coffee))
  (class-vars (name 'coffee))
  (initialize (ask self 'put 'calories 25)))

(define-class (restaurant name cuisine cost)
  (parent (place name))
  (method (menu)
          (list (ask cuisine 'name) cost))
  (method (sell person item)
          (if (or (and (equal? (ask person 'type) 'police)
                       (equal? item (ask cuisine 'name))
                       (ask person 'pay-money 0))
                  (and (equal? item (ask cuisine 'name))
                       (ask person 'pay-money cost)))
              (let ((goods (instantiate cuisine)))
                (ask self 'appear goods)
                goods)
              #f)))
             
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Implementation of thieves for part two
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (edible? thing)
  (ask thing 'get 'edible?))

(define-class (thief name initial-place)
  (parent (person name initial-place))
  (instance-vars
   (behavior 'steal))
  (initialize                                                     ;;;;;;;;;;;;;; initialize strength for thief
   (ask self 'put 'strength 1000))  
  (method (type) 'thief)

  (method (notice person)
    (cond ((eq? behavior 'run)
	   (if (not (null? (ask (usual 'place) 'exits)))          ;;;;;;;;;;;;;; B6b Can't leave an area without exits.
	      (ask self 'go (pick-random (ask (usual 'place) 'exits)))
	      (display "Can't leave the area.")))
	  (else
	   (let ((food-things
		  (filter (lambda (thing)
			    (and (edible? thing)
				 (not (eq? (ask thing 'possessor) self))))
			  (ask (usual 'place) 'things))))
	     (if (not (null? food-things))
		 (begin
		   (ask self 'take (car food-things))
		   (set! behavior 'run)
		   (ask self 'notice person))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B7 Police Class

(define-class (police name initial-place)
  (parent (person name initial-place))

  (initialize                                                     ;;;;;;;;;;;;;; initiate strength for police
   (ask self 'put 'strength 10000)) 

  (method (type) 'police)

  (method (notice person)
	  (cond ((and (equal? (ask person 'type) 'thief)
		     (> (ask self 'strength) (ask person 'strength)))
		 (begin
		   (newline)
		   (display "Crime Does Not Pay.")
		   (for-each (lambda (thing) (ask self 'take thing))
			     (ask person 'possessions))
		   (ask person 'go-directly-to jail)
		   ))
		(else
		 (display "Police: you may stay."))))
  (method (go direction)
	  (error "The police will stay."))
  (method (go-directly-to new-place)
	  (error "The police will stay.")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;		  
	      




;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility procedures
;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; this next procedure is useful for moving around

(define (move-loop who)
  (newline)
  (print (ask who 'exits))
  (display "?  > ")
  (let ((dir (read)))
    (if (equal? dir 'stop)
	(newline)
	(begin (print (ask who 'go dir))
	       (move-loop who)))))


;; One-way paths connect individual places.

(define (can-go from direction to)
  (ask from 'new-neighbor direction to))


(define (announce-take name thing)
  (newline)
  (display name)
  (display " took ")
  (display (ask thing 'name))
  (newline))

(define (announce-move name old-place new-place)
  (newline)
  (newline)
  (display name)
  (display " moved from ")
  (display (ask old-place 'name))
  (display " to ")
  (display (ask new-place 'name))
  (newline))

(define (have-fit p)
  (newline)
  (display "Yaaah! ")
  (display (ask p 'name))
  (display " is upset!")
  (newline))


(define (pick-random set)
  (nth (random (length set)) set))

(define (delete thing stuff)
  (cond ((null? stuff) '())
	((eq? thing (car stuff)) (cdr stuff))
	(else (cons (car stuff) (delete thing (cdr stuff)))) ))

;;(define (person? obj)
;;  (and (procedure? obj)
;;       (member? (ask obj 'type) '(person police thief))))

;;(define (thing? obj)
;;  (and (procedure? obj)
;;       (eq? (ask obj 'type) 'thing)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B4b redefine person? place? and thing?
(define (person? obj)
  (ask obj 'person?))

(define (place? obj)
  (ask obj 'place?))

(define (thing? obj)
  (ask obj 'thing?))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; B5
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; class Hotspot
(define-class (hotspot name code)
  (parent (place name))
  (instance-vars (alist '()) )
  (method (gone thing)
	  (define (disconnect-distant laptops)
	    (filter (lambda (laptop) (memq laptop (ask self 'things)))
		    laptops))
	  (usual 'gone thing)
	  (set! alist (disconnect-distant alist)))
  (method (connect laptop password)
	  (cond ((and (equal? password code)
		      (memq laptop (ask self 'things)))
		 (set! alist (cons laptop alist))
		 (display "Connection Successful") (newline))
		((not (equal? password code))
		 (display "The password is incorrect.")
		 (newline) (newline))
		(else (display "The laptop is not in this place.")
		      (newline))))
  (method (surf laptop url)
	  (if (memq laptop alist)
	      (system (string-append "lynx " url))))
  )

(define-class (locked-place name)
	(parent (place name))
	(instance-vars (locked? #t))
	(method (may-enter? person) (and (not locked?)
										(usual 'may-enter? person)))
	(method (unlock)
			(set! locked? #f)
			(print "Unlocked"))
	(method (type) 'locked-place))
	
(define-class (garage name)
	(parent (place name))
	(instance-vars (parked-cars '())
					(table (make-table)))
	(method (park a-car)
		(if (member? (ask a-car 'name) (map (lambda (x) (ask x 'name)) (ask self 'things)))
			(let ((own (ask a-car 'possessor))
                  (tkt (instantiate garage-ticket 'ticket)))
					(insert! (ask tkt 'num) a-car table)
					(ask own 'lose a-car)
                    (ask self 'appear tkt)
					(ask own 'take tkt))
			(print "Bring your car here first")))
  (method (unpark ticket)
          (if (not (eq? (ask ticket 'name) 'ticket))
              (print "This ticket is not valid")
              (let ((own (ask ticket 'possessor))
                    (tkt-num (ask ticket 'num)))
                (let ((a-car (lookup tkt-num table)))
                  (begin (ask own 'lose ticket)
                    (ask self 'gone ticket)
                    (insert! tkt-num #f table)
                    (ask own 'take a-car)))))))
                  

(define-class (counter)
  (instance-vars (cnt 0))
  (method (count) (begin (set! cnt (+ cnt 1))
                         cnt)))
  
(define gar-tkt-count (instantiate counter))

(define-class (garage-ticket ticket)
	(parent (thing ticket))
	(instance-vars (num (ask gar-tkt-count 'count))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; class laptop
(define-class (laptop name)
  (parent (thing name))

  (method (connect password)
	  (cond ((equal? (ask self 'possessor) 'no-one)
		 (display "Can not connect without a possessor.")
		 (newline))
		(else
		 (ask (ask (ask self 'possessor) 'place) 'connect self password))))

  (method (surf url)
	  (cond ((equal? (ask self 'possessor) 'no-one)
		 (display "Can not connect without a possessor.")
		 (newline))
		(else
		 (ask (ask (ask self 'possessor) 'place) 'surf self url)))))



